{
*******************************************************************************
-------------------------------------------------------------------------------
Kliper - next generation multimedia player
Copyright (C) Marcin 'vi4m' Kliks (vi4m@wp.pl)
Copyright (C) Tomasz 'dymsza' Odrobny (dymsza@gmail.com)
-------------------------------------------------------------------------------
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
*******************************************************************************
}

unit Core;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;


type Tcallback = procedure of object;
type TintCallback = procedure(x: integer) of object;
type TstringCallback = procedure(x: string) of object;


type TProcessor = class(TThread)
  private
    Data: string;

    procedure ClientDone;
    procedure Process;
    procedure Stop;
    procedure Loaded;
  protected
    procedure Execute; override;
  public
    ReadPipe: Cardinal;
    hPipe: Cardinal;
    interproc: TstringCallback;
    on_stop: Tcallback;
    on_mplayer_loaded: Tcallback;
    WritePipe: Cardinal;
  end;
type Trefresher = class(TThread)
  private
    on_refresh: Tcallback;
    procedure starcallback;
  protected
    procedure Execute; override;
  end;

type Tcore = class
    HomeDir: string;
    destructor Destroy;
    constructor create(on_message_: TstringCallback; on_stop_: Tcallback; on_mplayer_loaded_: Tcallback);
    procedure open_mplayer(param: string);
    procedure Terminate;
    procedure SendCommand(Command: string);
    procedure pause;
    procedure resume;
    procedure refresh;
  private
  //call back
    Processor: TProcessor;



    on_message: TstringCallback;
    on_stop: Tcallback;
    on_mplayer_loaded: Tcallback;
    ReadPipe: Cardinal;
    WritePipe: Cardinal;
    ClientProcess: Cardinal;



  end;

type Tmbshow = class(TThread)
  private
    msg_: string;
  protected
    procedure Execute; override;
  end;




procedure showasyncmsg(const msg: string; msgtype: integer);

var
  refresher: Trefresher;


implementation
uses about;
var
  msg_var: string;
  msg_type: integer;
  dump1: Cardinal;

procedure Tmbshow.Execute;
begin
  if msg_type = 0 then
    Messagebox(0, pchar(msg_var), 'ERROR', MB_ICONERROR)
  else Messagebox(0, pchar(msg_var), 'INFO', MB_ICONINFORMATION);
end;



procedure showasyncmsg(const msg: string; msgtype: integer);
var
  thr: Tmbshow;
begin
  msg_var := pchar(msg);
  thr := Tmbshow.Create(false);

end;



procedure Tcore.pause;
begin
  refresher.Suspend;
end;

procedure Tcore.resume;
begin
  refresher.Resume;
end;

destructor Tcore.Destroy;
begin
  Terminate;
  Processor.Destroy;
  refresher.Destroy;

end;

procedure Tcore.refresh;
begin
  SendCommand(('get_percent_pos'));
  SendCommand(('get_time_pos'));
end;

procedure Trefresher.starcallback;
begin
  on_refresh;
end;

procedure Trefresher.Execute;
begin
  repeat
    Sleep(100);
    Synchronize(starcallback);
  until 1 = 0;
end;


constructor Tcore.create(on_message_: TstringCallback; on_stop_: Tcallback; on_mplayer_loaded_: Tcallback);
begin
  refresher := Trefresher.Create(true);
  refresher.on_refresh := refresh;
  on_message := on_message_;
  on_stop := on_stop_;
  on_mplayer_loaded := on_mplayer_loaded_;
  HomeDir := IncludeTrailingPathDelimiter(ExtractFileDir(ExpandFileName(ParamStr(0))));

end;

procedure Tcore.open_mplayer(param: string);
var DummyPipe1, DummyPipe2: THandle;
  si: TStartupInfo;
  pi: TProcessInformation;
  sec: TSecurityAttributes;
  CmdLine: string;
begin

  Processor := TProcessor.Create(true);

  with sec do begin
    nLength := sizeof(sec);
    lpSecurityDescriptor := nil;
    bInheritHandle := true;
  end;
  CreatePipe(ReadPipe, DummyPipe1, @sec, 0);

  with sec do begin
    nLength := sizeof(sec);
    lpSecurityDescriptor := nil;
    bInheritHandle := true;
  end;
  CreatePipe(DummyPipe2, WritePipe, @sec, 0);
  FillChar(si, sizeof(si), 0);
  si.cb := sizeof(si);
  si.dwFlags := STARTF_USESTDHANDLES;
  si.hStdInput := DummyPipe2;
  si.hStdOutput := DummyPipe1;
  si.hStdError := DummyPipe1;
  CreateProcess(nil, PChar(param), nil, nil, true, DETACHED_PROCESS, nil, PChar(HomeDir), si, pi);
  CloseHandle(DummyPipe1);
  CloseHandle(DummyPipe2);
  ClientProcess := pi.hProcess;
  Processor.hPipe := ReadPipe;
  Processor.interproc := on_message;
  Processor.on_stop := on_stop;
  Processor.on_mplayer_loaded := on_mplayer_loaded;
  Processor.ReadPipe := ReadPipe;
  Processor.WritePipe := WritePipe;
  Processor.Resume;
end;

procedure TProcessor.Stop;
begin
  on_stop;
end;

procedure TProcessor.Process;
var EOL: integer;
begin
  EOL := Pos(#10, Data);
  if eol < 1 then
    interproc(data);
  while EOL > 0 do begin
    interproc(Copy(Data, 1, EOL - 1));
    Delete(Data, 1, EOL);
    EOL := Pos(#10, Data);
  end;

end;

procedure TProcessor.Loaded;
begin
  on_mplayer_loaded;
end;

procedure TProcessor.Execute;
var
  WasOK: Boolean;
  Buffer: array[0..255] of Char;
  BytesRead: Cardinal;
  counter: integer;
begin
  counter := 0;
  repeat
    Data := '';
    WasOK := ReadFile(ReadPipe, Buffer, 255, BytesRead, nil);
    if BytesRead > 0 then
    begin
      if counter = 0 then begin Synchronize(Loaded);
        refresher.Resume;
        counter := 1; end;
      Buffer[BytesRead] := #0;
      Data := Buffer;
            //on_message
      Synchronize(Process);
    end;
  until not WasOK or (BytesRead = 0);
// on stop

  Synchronize(stop);
  Synchronize(ClientDone);
end;



procedure Tcore.Terminate;
begin
  TerminateProcess(ClientProcess, cardinal(-1));

end;

procedure Tcore.SendCommand(Command: string);
var Dummy: cardinal;
begin
  if (ClientProcess = 0) or (WritePipe = 0) then exit;
  Command := Command + #10;
  WriteFile(WritePipe, Command[1], length(Command), Dummy, nil);

end;

procedure TProcessor.ClientDone;
begin
  CloseHandle(ReadPipe); ReadPipe := 0;
  CloseHandle(WritePipe); WritePipe := 0;
end;


end.
